Gurewich OLE Controls for Visual Basic 4/Gurewich OLE Controls for Visual Basic 4.iso/ocxprog/programs/ch12/wave.frm

Visual Basic Form | 1995-08-24 | 18.7 KB | 587 lines

VERSION 4.00
Begin VB.Form frmWave
   BackColor       =   &H00008000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "The Wave Program"
   ClientHeight    =   5175
   ClientLeft      =   645
   ClientTop       =   1785
   ClientWidth     =   7215
   Height          =   5865
   Icon            =   "WAVE.frx":0000
   Left            =   585
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   345
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   481
   Top             =   1155
   Width           =   7335
   Begin VB.CommandButton cmdDelete
      Caption         =   "&Delete"
      Height          =   615
      Left            =   6000
      TabIndex        =   7
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton cmdRecord
      Caption         =   "&Record"
      Height          =   615
      Left            =   4800
      TabIndex        =   5
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton cmdEndOfFile
      Caption         =   "&End of File"
      Height          =   615
      Left            =   3600
      TabIndex        =   3
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton cmdRewind
      Caption         =   "&Rewind"
      Height          =   615
      Left            =   2400
      TabIndex        =   2
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton cmdStop
      Caption         =   "&Stop"
      Height          =   615
      Left            =   1200
      TabIndex        =   1
      Top             =   4560
      Width           =   1215
   End
   Begin VB.CommandButton cmdPlay
      Caption         =   "&Play"
      Height          =   615
      Left            =   0
      TabIndex        =   0
      Top             =   4560
      Width           =   1215
   End
   Begin VB.Label lblRecording
      BackColor       =   &H00008000&
      Caption         =   "Recording in progress..."
      BeginProperty Font
         name            =   "MS Sans Serif"
         charset         =   0
         weight          =   400
         size            =   29.25
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   735
      Left            =   600
      TabIndex        =   6
      Top             =   0
      Visible         =   0   'False
      Width           =   6495
   End
   Begin TegoswLibCtl.Tegosw swExit
      Height          =   630
      Left            =   0
      TabIndex        =   4
      Top             =   0
      Width           =   525
      _version        =   65536
      _extentx        =   926
      _extenty        =   1111
      _stockprops     =   64
      value           =   -1  'True
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   3240
      Top             =   2760
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      CancelError     =   -1  'True
   End
   Begin TegowavLib.TegoWav TegoWav1
      Height          =   600
      Left            =   3000
      TabIndex        =   8
      Top             =   1440
      Width           =   930
      _version        =   65536
      _extentx        =   1640
      _extenty        =   1058
      _stockprops     =   0
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuOpen
         Caption         =   "&Open..."
      End
      Begin VB.Menu mnuClose
         Caption         =   "&Close"
      End
      Begin VB.Menu mnuSep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuInfo
         Caption         =   "&Info..."
      End
      Begin VB.Menu mnuSep2
         Caption         =   "-"
      End
      Begin VB.Menu mnuSave
         Caption         =   "&Save"
      End
      Begin VB.Menu mnuSaveAs
         Caption         =   "Save &As..."
      End
      Begin VB.Menu mnuSep3
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuVolume
      Caption         =   "&Volume"
      Begin VB.Menu mnuIncreaseVolume
         Caption         =   "&Increase Volume (25%)"
      End
      Begin VB.Menu mnuDecreaseVolume
         Caption         =   "&Decrease Volume (25%)"
      End
   End
   Begin VB.Menu mnuSpeed
      Caption         =   "&Speed"
      Begin VB.Menu mnuIncreaseSpeed
         Caption         =   "&Increase Speed (10%)"
      End
      Begin VB.Menu mnuDecreaseSpeed
         Caption         =   "&Decrease Speed (10%)"
      End
      Begin VB.Menu mnuSep4
         Caption         =   "-"
      End
      Begin VB.Menu mnuNormalSpeed
         Caption         =   "&Normal Speed"
      End
   End
   Begin VB.Menu mnuHelp
      Caption         =   "&Help"
      Begin VB.Menu mnuAbout
         Caption         =   "&About..."
      End
   End
Attribute VB_Name = "frmWave"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
' All variables must be declared.
Option Explicit
' Declaration of general variables.
Dim gWavArray() As Integer
Dim gArrayLength As Long
Dim gRecordingInProgress As Boolean
Dim gNormalSamplingRate As Long
Private Sub cmdDelete_Click()
' Delete all the samples of the WAV file.
TegoWav1.Delete 0, -1
' The WAV file is now empty, so reset the
' length of the WAV array to 0.
gArrayLength = 0
ReDim gWavArray(gArrayLength)
' Draw the graph.
DrawGraph
End Sub
Private Sub cmdEndOfFile_Click()
' Seek to the end of file.
TegoWav1.Seek -1
End Sub
Private Sub cmdPlay_Click()
' Play from the current playback position to the
' end of the WAV file, and don't wait while playing.
TegoWav1.Play -1, -1, False
End Sub
Private Sub cmdRecord_Click()
   ' Record from the current playback position
   ' without limitation, and don't wait while
   ' recording.
   TegoWav1.Record -1, -1, False
   ' If Record command was successful, set the
   ' gRecordingInProgress variable to True, and
   ' make the lblRecording label visible.
   If TegoWav1.GetErrorCode = 0 Then
      gRecordingInProgress = True
      lblRecording.Visible = True
   End If
End Sub
Private Sub cmdRewind_Click()
' Change the playback position to the beginning
' of the WAV file.
TegoWav1.Seek 0
End Sub
Private Sub cmdstop_Click()
  ' Stop the playback (or stop the recording).
  TegoWav1.Stop
End Sub
Private Sub Form_Load()
 TegoWav1.Visible = False
 ' Initially, no WAV file is open, so we execute the
 ' mnuClose_Click() procedure to disable various
 ' controls.
 mnuClose_Click
End Sub
Private Sub Form_Paint()
  ' Draw the graph.
  DrawGraph
End Sub
Private Sub mnuAbout_Click()
   Dim Title
   Dim Msg
   Dim CR
   CR = Chr(13) + Chr(10)
   ' The title of the About message box.
   Title = "About the Wave Program"
   ' Prepare the message of the About message box.
   Msg = "This program was written with Visual "
   Msg = Msg + "Basic for Windows, using the "
   Msg = Msg + "TegoSoft Wave OCX control. "
   Msg = Msg + CR + CR
   Msg = Msg + "The TegoSoft Wave OCX control "
   Msg = Msg + "is part of the TegoSoft OCX Control "
   Msg = Msg + "Kit - a collection of various OCX controls. "
   Msg = Msg + CR + CR
   Msg = Msg + "For more information about the "
   Msg = Msg + "TegoSoft OCX Control Kit, contact TegoSoft "
   Msg = Msg + "at:"
   Msg = Msg + CR + CR
   Msg = Msg + "TegoSoft Inc." + CR
   Msg = Msg + "P.O. Box 389" + CR
   Msg = Msg + "Bellmore, NY 11710"
   Msg = Msg + CR + CR
   Msg = Msg + "Phone: [phone]"
   ' Display the About message box.
   MsgBox Msg, vbInformation, Title
End Sub
Private Sub mnuClose_Click()
' Close the WAV file.
TegoWav1.Close
' No WAV file is currently open, so reset the
' length of the WAV array to 0.
gArrayLength = 0
ReDim gWavArray(gArrayLength)
' Initialize the gRecordingInProgress flag to False.
gRecordingInProgress = False
' No WAV file is currently open, so we disable
' the Volume, Speed, Close, Info, Save,
' SaveAs, Play, Stop,Rewind, EndOfFile,
' Record and Delete controls.
mnuIncreaseVolume.Enabled = False
mnuDecreaseVolume.Enabled = False
mnuIncreaseSpeed.Enabled = False
mnuDecreaseSpeed.Enabled = False
mnuNormalSpeed.Enabled = False
mnuClose.Enabled = False
mnuInfo.Enabled = False
mnuSave.Enabled = False
mnuSaveAs.Enabled = False
cmdPlay.Enabled = False
cmdstop.Enabled = False
cmdRewind.Enabled = False
cmdEndOfFile.Enabled = False
cmdRecord.Enabled = False
cmdDelete.Enabled = False
' Set the title of the program's window.
Me.Caption = "The Wave Program"
' Draw the graph.
DrawGraph
End Sub
Private Sub mnuDecreaseSpeed_Click()
Dim SamplingRate
' Get the current sampling rate.
SamplingRate = TegoWav1.GetSamplingRate
' Decrease SamplingRate by 10%.
SamplingRate = SamplingRate * 0.9
' Set the mouse pointer to hourglass.
Me.MousePointer = 11
' Set the new sampling rate.
TegoWav1.SetSamplingRate SamplingRate
' Set the mouse pointer to default.
Me.MousePointer = 0
End Sub
Private Sub mnuDecreaseVolume_Click()
 ' Set the mouse pointer to hourglass.
 Me.MousePointer = 11
 ' Decrease the volume of all the samples of the
 ' WAV file by 25%.
 TegoWav1.ChangeVolume 0, -1, 0.75
 ' Update the gWavArray array.
 TegoWav1.WavFileToArray gWavArray(0), gArrayLength
 ' Draw the graph.
 DrawGraph
 ' Set the mouse pointer to the default.
 Me.MousePointer = 0
End Sub
Private Sub mnuExit_Click()
   ' Terminate the program.
   Unload Me
End Sub
Private Sub mnuIncreaseSpeed_Click()
Dim SamplingRate As Long
' Get the current sampling rate.
SamplingRate = TegoWav1.GetSamplingRate
' If SamplingRate is at its maximum value, tell
' the user and terminate this procedure.
If SamplingRate = 44100 Then
   MsgBox "Sampling Rate cannot be more than 44100 Hertz!"
   Exit Sub
End If
' Increase SamplingRate by 10%.
SamplingRate = SamplingRate * 1.1
' If SamplingRate is greater than the maximum (44100),
' reset it to 44100.
If SamplingRate > 44100 Then SamplingRate = 44100
' Set the mouse pointer to hourglass.
Me.MousePointer = 11
' Set the new sampling rate.
TegoWav1.SetSamplingRate SamplingRate
' Set the mouse pointer to the default.
Me.MousePointer = 0
End Sub
Private Sub mnuIncreaseVolume_Click()
 ' Set the mouse pointer to hourglass.
 Me.MousePointer = 11
 ' Increase the volume of all the samples of the
 ' WAV file by 25%.
 TegoWav1.ChangeVolume 0, -1, 1.25
 ' Update the gWavArray array.
 TegoWav1.WavFileToArray gWavArray(0), gArrayLength
 ' Draw the graph.
 DrawGraph
 ' Set the mouse pointer to the default.
 Me.MousePointer = 0
End Sub
Private Sub mnuInfo_Click()
Dim Title
Dim Msg
Dim CRLF
CRLF = Chr(13) + Chr(10)
' The title of the Info message box.
Title = "WAV File Information"
' Prepare the message for the Info message box.
Msg = "File Name: " + TegoWav1.GetWavFilename
Msg = Msg + CRLF
Msg = Msg + "File Length: " + Str(TegoWav1.GetLength) + " samples."
Msg = Msg + CRLF
Msg = Msg + "Sampling Rate: " + Str(TegoWav1.GetSamplingRate) + " Hz."
Msg = Msg + CRLF
Msg = Msg + "Number of Bits Per Sample: " + Str(TegoWav1.GetNumBits)
Msg = Msg + CRLF
Msg = Msg + "Number of Channels: " + Str(TegoWav1.GetNumChannels)
' Display the Info message box.
MsgBox Msg, vbInformation, Title
End Sub
Private Sub mnuNormalSpeed_Click()
' Set the mouse pointer to hourglass.
Me.MousePointer = 11
' Set the sampling rate of the WAV file to the
' normal sampling rate.
TegoWav1.SetSamplingRate gNormalSamplingRate
' Set the mouse pointer to default.
Me.MousePointer = 0
End Sub
Private Sub mnuOpen_Click()
    ' Set an error trap to detect the clicking
    ' of the Cancel key of the Open dialog box.
    On Error GoTo OpenError
    ' Fill the items of the File Type list box of
    ' the Open dialog box.
    CommonDialog1.Filter = "All Files (*.*)|*.*|Wave Files (*.wav)|*.wav"
    ' Set the default File Type to Wave Files (*.wav).
    CommonDialog1.FilterIndex = 2
    ' Display the Open dialog box.
    CommonDialog1.Action = 1
    ' Remove the error trap.
    On Error GoTo 0
    ' Open the WAV file that the user selected.
    TegoWav1.Open CommonDialog1.filename
    ' If Open command failed, exit this procedure.
    If TegoWav1.GetErrorCode <> 0 Then
       MsgBox "Cannot open " + CommonDialog1.filename, 0, "ERROR"
       mnuClose_Click
       Exit Sub
    End If
    ' Set the mouse pointer to hourglass.
    Me.MousePointer = 11
    ' Update the WAV array with the samples of the WAV file.
    gArrayLength = TegoWav1.GetLength() * TegoWav1.GetNumChannels()
    ReDim gWavArray(gArrayLength)
    TegoWav1.WavFileToArray gWavArray(0), gArrayLength
   ' Set the mouse pointer to default.
    Me.MousePointer = 0
    ' If updating of the WAV array failed, close
    ' the WAV file.
    If TegoWav1.GetErrorCode > 0 Then
       mnuClose_Click
       Exit Sub
    End If

    ' Store the sampling rate of the WAV file.
    gNormalSamplingRate = TegoWav1.GetSamplingRate
    ' Display the name of the WAV file (without the path).
    Me.Caption = "The Wave Program - " + CommonDialog1.FileTitle
    ' Draw the graph
    DrawGraph
    ' A WAV file is now open, so enable
    ' the Volume, Speed, Close, Info, Save,
    ' SaveAs, Play, Stop, Rewind, EndOfFile,
    ' Record, and Delete controls.
    mnuIncreaseVolume.Enabled = True
    mnuDecreaseVolume.Enabled = True
    mnuIncreaseSpeed.Enabled = True
    mnuDecreaseSpeed.Enabled = True
    mnuNormalSpeed.Enabled = True
    mnuClose.Enabled = True
    mnuInfo.Enabled = True
    mnuSave.Enabled = True
    mnuSaveAs.Enabled = True
    cmdPlay.Enabled = True
    cmdstop.Enabled = True
    cmdRewind.Enabled = True
    cmdEndOfFile.Enabled = True
    cmdRecord.Enabled = True
    cmdDelete.Enabled = True
    ' Exit the procedure.
    Exit Sub
OpenError:
    ' The user clicked the Cancel button of the
    ' Open File dialog box.
    Exit Sub
End Sub
Private Sub mnuSave_Click()
' Save the WAV file to the disk.
TegoWav1.Save
End Sub
Private Sub mnuSaveAs_Click()
    Dim Msg, Answer
    ' Set an error trap to detect the clicking
    ' of the Cancel key of the Save As dialog box.
    On Error GoTo SaveAsError
    ' Fill the items of the File Type list box of
    ' the Open dialog box.
    CommonDialog1.Filter = "All Files (*.*)|*.*|Wave Files (*.wav)|*.wav"
    ' Set the default File Type to Wave Files (*.wav).
    CommonDialog1.FilterIndex = 2
    ' Display the Save As dialog box.
    CommonDialog1.Action = 2
    ' Remove the error trap.
    On Error GoTo 0
    ' If the file specified by the user exists, and its
    ' size is not zero, ask the user if to overwrite it.
    If Dir(CommonDialog1.filename) <> "" Then
       Msg = CommonDialog1.filename + Chr(13)
       Msg = Msg + "This WAV file already exists." + Chr(13) + Chr(13)
       Msg = Msg + "Replace existing file?"
       Answer = MsgBox(Msg, vbExclamation + vbYesNo)
       If Answer = vbNo Then
          Exit Sub
       End If
    End If
    ' Set the mouse pointer to hourglass.
    Me.MousePointer = 11
    ' Issue a SaveAs command.
    TegoWav1.SaveAs CommonDialog1.filename
    ' Set the mouse cursor to default.
    Me.MousePointer = 0
    ' If the SaveAs command failed, tell the user,
    ' and abort this procedure.
    If TegoWav1.GetErrorCode <> 0 Then
       MsgBox "Cannot save " + CommonDialog1.filename, 0, "ERROR"
       Exit Sub
    End If
    ' Set the title of the Window.
    Me.Caption = "The Wave Program - " + CommonDialog1.FileTitle
    ' Exit the procedure.
    Exit Sub
SaveAsError:
    ' The user clicked the Cancel button.
    Exit Sub
End Sub
Private Sub swExit_Click()
   Dim Title
   Dim Question
   Dim Response
   ' If the user turned the swExit switch OFF,
   ' confirm that the user wants to exit the
   ' program, and if so, exit the program.
   If swExit.Value = False Then
      Title = "Exit Program"
      Question = "Are you sure you want to exit?"
      Response = MsgBox(Question, vbYesNo + vbQuestion, Title)
      If Response = vbYes Then
         Unload Me
      Else
         swExit.Value = True
      End If
   End If
End Sub
Private Sub TegoWav1_Done(ByVal NotifyCode As Integer)
    ' If current playback position is at the end
    ' of the WAV file, change the playback position
    ' to the beginning of the WAV file.
    If TegoWav1.GetPosition = TegoWav1.GetLength Then
       TegoWav1.Seek 0
    End If
    ' Has recording just stopped?
    If gRecordingInProgress = True Then

       ' Recording is now not in progress.
       gRecordingInProgress = False

       ' Hide the lblRecording label.
       lblRecording.Visible = False

       ' Update the gWavArray array.
       Me.MousePointer = 11
       gArrayLength = TegoWav1.GetLength() * TegoWav1.GetNumChannels()
       ReDim gWavArray(gArrayLength)
       TegoWav1.WavFileToArray gWavArray(0), gArrayLength
       Me.MousePointer = 0
       ' Draw the graph.
       DrawGraph
    End If
End Sub
Public Sub DrawGraph()
    Dim I
    Dim Sample
    Dim MidPoint
    Dim Increment
    Dim SampleNumber
    ' Clear the current graph.
    Cls
    ' Calculate the midpoint of the form
    MidPoint = Me.ScaleHeight / 2
    ' Draw a horizontal line in the middle of the
    ' form (the x-axis).
    Line (0, MidPoint)-(Me.ScaleWidth, MidPoint)
    ' If the WAV array is empty, terminate this procedure.
    If gArrayLength = 0 Then
       Exit Sub
    End If
    ' Display the bars of the graph.
    Increment = gArrayLength / Me.ScaleWidth
    For I = 0 To Me.ScaleWidth Step 1
        SampleNumber = I * Increment
        Sample = gWavArray(SampleNumber)
        If TegoWav1.GetNumBits = 8 Then
           Line (I, MidPoint)-(I, MidPoint - Sample + 128)
        Else
           Line (I, MidPoint)-(I, MidPoint - (Sample / 260))
        End If
    Next I
End Sub